Delphi 5 for Professionals/DELPHI5.iso/AddOns/Components/Orpheus v3.02/SETUP.EXE/%MAINDIR%/OvcState.pas

Pascal/Delphi Source File | 1999-02-25 | 19.9 KB | 808 lines

{*********************************************************}
{*                  OVCSTATE.PAS 3.00                    *}
{*     Copyright (c) 1995-99 TurboPower Software Co      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I OVC.INC}

{$B-} {Complete Boolean Evaluation}
{$I+} {Input/Output-Checking}
{$P+} {Open Parameters}
{$T-} {Typed @ Operator}
{$W-} {Windows Stack Frame}
{$X+} {Extended Syntax}

{$IFNDEF Win32}
{$G+} {286 Instructions}
{$N+} {Numeric Coprocessor}

{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
{$ENDIF}

unit OvcState;
  {-component to save and restore the form state}

interface

uses
  {$IFDEF Win32} Windows, Registry, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes, Controls, IniFiles, Forms, Messages, SysUtils,
  OvcBase, OvcData, OvcMisc, OvcFiler;

type
  TOvcFormStateOption  = (fsState, fsPosition, fsActiveControl
       {$IFDEF VERSION4}, fsDefaultMonitor{$ENDIF});
  TOvcFormStateOptions = set of TOvcFormStateOption;

type
  TOvcAbstractState = class(TOvcComponent)
  {.Z+}
  protected {private}
    {property variables}
    FActive             : Boolean;
    FSection            : string;
    FStorage            : TOvcAbstractStore;

    {event variables}
    FOnSaveState        : TNotifyEvent;
    FOnRestoreState     : TNotifyEvent;

    {internal variables}
    isDestroying         : Boolean;
    isRestored           : Boolean;
    isSaved              : Boolean;
    isSaveFormCreate     : TNotifyEvent;
    isSaveFormDestroy    : TNotifyEvent;
    isSaveFormCloseQuery : TCloseQueryEvent;

    {property methods}
    function GetForm : TCustomForm;
    function GetSection : string;
    procedure SetStorage(Value : TOvcAbstractStore);

    {internal methods}
    procedure FormCloseQuery(Sender : TObject; var CanClose : Boolean);
    procedure FormCreate(Sender : TObject);
    procedure FormDestroy(Sender : TObject);
    procedure RestoreEvents;

  protected
    procedure Loaded;
      override;
    procedure Notification(AComponent : TComponent; Operation : TOperation);
      override;

    procedure DoOnRestoreState;
      dynamic;
    procedure DoOnSaveState;
      dynamic;

    procedure RestoreStatePrim;
      virtual; abstract;
    procedure SaveStatePrim;
      virtual; abstract;
    procedure SetEvents;
      dynamic;

    property Form : TCustomForm
      read GetForm;
  {.Z-}

    {properties}
    property Active : Boolean
      read FActive write FActive;
    property Section : string
      read GetSection write FSection;
    property Storage : TOvcAbstractStore
      read FStorage write SetStorage;

    {events}
    property OnSaveState : TNotifyEvent
      read FOnSaveState write FOnSaveState;

    property OnRestoreState : TNotifyEvent
      read FOnRestoreState write FOnRestoreState;

  public
  {.Z+}
    constructor Create(AOwner : TComponent);
      override;
    destructor Destroy;
      override;
  {.Z-}

    procedure RestoreState;
    procedure SaveState;
  end;

  TOvcFormState = class(TOvcAbstractState)
  {.Z+}
  protected {private}
    {property variables}
    FOptions     : TOvcFormStateOptions;

    {internal variables}
    FDefMaximize : Boolean;

    {internal methods}
    procedure UpdateFormState;
    procedure ReadFormState(Form : TCustomForm; const Section : string;
              LoadState, LoadPosition : Boolean);
    procedure WriteFormState(Form : TCustomForm; const Section : string);

  protected
    procedure RestoreStatePrim;
      override;
    procedure SaveStatePrim;
      override;

  public
    constructor Create(AOwner : TComponent);
      override;
  {.Z-}

  published
    {properties}
    property Active;
    property Options : TOvcFormStateOptions
      read FOptions write FOptions;
    property Section;
    property Storage;

    {events}
    property OnSaveState;
    property OnRestoreState;
  end;

  TOvcComponentState = class(TOvcAbstractState)
  {.Z+}
  protected {private}
    {property variables}
    FStoredProperties : TStrings;

    procedure SetStoredProperties(Value : TStrings);

  protected
    procedure Loaded;
      override;
    procedure Notification(AComponent : TComponent; Operation : TOperation);
      override;
    procedure RestoreStatePrim;
      override;
    procedure SaveStatePrim;
      override;
    procedure WriteState(Writer: TWriter);
      override;

  public
    constructor Create(AOwner: TComponent);
      override;
    destructor Destroy;
      override;
    procedure SetNotification;
  {.Z-}

  published
    {properties}
    property Active;
    property Section;
    property Storage;
    property StoredProperties : TStrings
      read FStoredProperties write SetStoredProperties;

    {events}
    property OnSaveState;
    property OnRestoreState;
  end;

  TOvcPersistentState = class(TOvcComponent)
  {.Z+}
  protected {private}
    {property variables}
    FStorage : TOvcAbstractStore;

    {property methods}
    procedure SetStorage(Value : TOvcAbstractStore);

  protected
    procedure Notification(AComponent : TComponent; Operation : TOperation);
      override;
  {.Z-}

  public
    procedure RestoreState(AnObject : TPersistent; const ASection : string);
    procedure SaveState(AnObject : TPersistent; const ASection : string);

  published
    {properties}
    property Storage : TOvcAbstractStore
      read FStorage write SetStorage;
  end;


implementation


const
  cActiveCtrl = 'ActiveControl';
  cFlags      = 'Flags';
  cItem       = 'Item%d';
  cListCount  = 'Count';
  cMDIChild   = 'MDI Children';
  cNormPos    = 'NormalPos';
  cShowCmd    = 'ShowCmd';
  cMonitor    = 'DefaultMonitor';


{*** utility routines ***}

function GetDefaultSection(Component : TComponent) : string;
var
  F     : TForm;
  Owner : TComponent;
begin
  if Component <> nil then begin
    if Component is TCustomForm then
      Result := Component.ClassName
    else begin
      Result := Component.Name;
      if Component is TControl then begin
        F := TForm(GetParentForm(TControl(Component)));
        if F <> nil then
          Result := F.ClassName + Result
        else begin
          if TControl(Component).Parent <> nil then
            Result := TControl(Component).Parent.Name + Result;
        end;
      end else begin
        Owner := Component.Owner;
        if Owner is TCustomForm then
          Result := Format('%s.%s', [Owner.ClassName, Result]);
      end;
    end;
  end else
    Result := '';
end;


{*** TOvcAbstractState ***}

constructor TOvcAbstractState.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FActive := True;
end;

destructor TOvcAbstractState.Destroy;
begin
  if not (csDesigning in ComponentState) then
    RestoreEvents;

  inherited Destroy;
end;

procedure TOvcAbstractState.DoOnSaveState;
begin
  if Assigned(FOnSaveState) then
    FOnSaveState(Self);
end;

procedure TOvcAbstractState.DoOnRestoreState;
begin
  if Assigned(FOnRestoreState) then
    FOnRestoreState(Self);
end;

procedure TOvcAbstractState.FormCloseQuery(Sender : TObject; var CanClose : Boolean);
begin
  if Assigned(isSaveFormCloseQuery) then
    isSaveFormCloseQuery(Sender, CanClose);

  if CanClose and Active and (Form.Handle <> 0) then
    try
      SaveState;
    except
      Application.HandleException(Self);
    end;
end;

procedure TOvcAbstractState.FormCreate(Sender : TObject);
begin
  {call original OnCreate event for form}
  if Assigned(isSaveFormCreate) then
    isSaveFormCreate(Sender);

  if Active then begin
    try
      RestoreState;
    except
      Application.HandleException(Self);
    end;
  end;
end;

procedure TOvcAbstractState.FormDestroy(Sender : TObject);
begin
  if Active and not isSaved then begin
    isDestroying := True;
    try
      SaveState;
    except
      Application.HandleException(Self);
    end;
    isDestroying := False;
  end;

  if Assigned(isSaveFormDestroy) then
    isSaveFormDestroy(Sender);
end;

function TOvcAbstractState.GetForm : TCustomForm;
begin
  Result := Owner as TCustomForm;
end;

function TOvcAbstractState.GetSection : string;
begin
  if FSection > '' then
    Result := FSection
  else
    Result := GetDefaultSection(Owner);
end;

procedure TOvcAbstractState.Loaded;
var
  WasLoading : Boolean;
begin
  WasLoading := csLoading in ComponentState;

  inherited Loaded;

  if not (csDesigning in ComponentState) then
    if WasLoading then
      SetEvents;
end;

procedure TOvcAbstractState.Notification(AComponent : TComponent; Operation : TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if (AComponent = FStorage) then begin
      FActive := False;
      FStorage := nil;
    end;
end;

procedure TOvcAbstractState.RestoreState;
begin
  isSaved := False;
  RestoreStatePrim;
  isRestored := True;
  DoOnRestoreState;
end;

procedure TOvcAbstractState.SaveState;
begin
  if isRestored or not Active then begin
    SaveStatePrim;
    DoOnSaveState;
    isSaved := True;
  end;
end;

procedure TOvcAbstractState.RestoreEvents;
begin
  if Owner <> nil then
    with TForm(Form) do begin
      OnCreate := isSaveFormCreate;
      OnCloseQuery := isSaveFormCloseQuery;
      OnDestroy := isSaveFormDestroy;
    end;
end;

procedure TOvcAbstractState.SetEvents;
begin
  with TForm(Form) do begin
    isSaveFormCreate := OnCreate;
    OnCreate := FormCreate;
    isSaveFormCloseQuery := OnCloseQuery;
    OnCloseQuery := FormCloseQuery;
    isSaveFormDestroy := OnDestroy;
    OnDestroy := FormDestroy;
  end;
end;

procedure TOvcAbstractState.SetStorage(Value : TOvcAbstractStore);
begin
  FStorage := Value;
  {$IFDEF Win32}
  if Value <> nil then
    Value.FreeNotification(Self);
  {$ENDIF}
end;


{*** TOvcFormState ***}

constructor TOvcFormState.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  if AOwner is TCustomForm then
    FOptions := [fsState, fsPosition]
  else
    FOptions := [];
end;

{$IFDEF WIN32}
  {$HINTS OFF}
{$ENDIF}
type
  TFormFriend = class(TScrollingWinControl)
  private
    FActiveControl  : TWinControl;
    FFocusedControl : TWinControl;
    FBorderIcons    : TBorderIcons;
    FBorderStyle    : TFormBorderStyle;
    FWindowState    : TWindowState;
  end;

procedure TOvcFormState.ReadFormState(Form : TCustomForm;
          const Section : string; LoadState, LoadPosition : Boolean);
const
  Delims = [',', ' '];
var
  Placement : TWindowPlacement;
  WinState  : TWindowState;
  S         : string;
begin
  if not Assigned(FStorage) then
    Exit;
  if not (LoadState or LoadPosition) then
    Exit;

  FillChar(Placement, SizeOf(Placement), #0);
  Placement.Length := SizeOf(TWindowPlacement);
  GetWindowPlacement(Form.Handle, @Placement);
  with Placement, TForm(Form) do begin
    ShowCmd := SW_HIDE;

    if LoadPosition then begin
      Flags := StrToIntDef(FStorage.ReadString(Section, cFlags, ''), Flags);
      S := FStorage.ReadString(Section, cNormPos, '');
      if S <> '' then begin
        if (Form is TForm) then
          TForm(Form).Position := poDesigned;
        rcNormalPosition.Left := StrToIntDef(ExtractWord(1, S, Delims), Left);
        rcNormalPosition.Top := StrToIntDef(ExtractWord(2, S, Delims), Top);
        rcNormalPosition.Right := StrToIntDef(ExtractWord(3, S, Delims), Left + Width);
        rcNormalPosition.Bottom := StrToIntDef(ExtractWord(4, S, Delims), Top + Height);

        if not (BorderStyle in [bsSizeable {$IFDEF WIN32}, bsSizeToolWin {$ENDIF}]) then
          rcNormalPosition := Rect(rcNormalPosition.Left, rcNormalPosition.Top,
            rcNormalPosition.Left + Width, rcNormalPosition.Top + Height);
        if rcNormalPosition.Right > rcNormalPosition.Left then
          SetWindowPlacement(Handle, @Placement);
      end;
    end;

    if LoadState then begin
      WinState := wsNormal;
      {default maximize MDI main form}
      if (Application.MainForm = Form) and (FormStyle = fsMDIForm) then
        WinState := wsMaximized;
      ShowCmd := StrToIntDef(FStorage.ReadString(Section, cShowCmd, ''), SW_HIDE);
      case ShowCmd of
        SW_SHOWNORMAL, SW_RESTORE, SW_SHOW : WinState := wsNormal;
        SW_MINIMIZE, SW_SHOWMINIMIZED      : WinState := wsMinimized;
        SW_MAXIMIZE                        : WinState := wsMaximized;
      end;
      {$IFDEF WIN32}
      if (WinState = wsMinimized) and (Form = Application.MainForm) then begin
        TFormFriend(Form).FWindowState := wsNormal;
        PostMessage(Application.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
        Exit;
      end;
      {$ENDIF}
      if FormStyle in [fsMDIChild, fsMDIForm] then
        TFormFriend(Form).FWindowState := WinState
      else
        WindowState := WinState;
    end;

    {$IFDEF VERSION4}
    if fsDefaultMonitor in Options then begin
      S :=FStorage.ReadString(Section, cMonitor, '');
      if (S > '') then
        try
          DefaultMonitor := TDefaultMonitor(StrToInt(S));
        except
        end;
    end;
    {$ENDIF}

    Update;
  end;
end;

procedure TOvcFormState.WriteFormState(Form : TCustomForm; const Section : string);
var
  Placement : TWindowPlacement;
begin
  if not Assigned(FStorage) then
    Exit;

  Placement.Length := SizeOf(TWindowPlacement);
  GetWindowPlacement(Form.Handle, @Placement);

  with Placement, TForm(Form) do begin
    if (Form = Application.MainForm) and IsIconic(Application.Handle) then
      ShowCmd := SW_SHOWMINIMIZED;
    if (FormStyle = fsMDIChild) and (WindowState = wsMinimized) then
      Flags := Flags or WPF_SETMINPOSITION;
    FStorage.WriteString(Section, cFlags, IntToStr(Flags));
    FStorage.WriteString(Section, cShowCmd, IntToStr(ShowCmd));
    FStorage.WriteString(Section, cNormPos, Format('%d,%d,%d,%d',
      [rcNormalPosition.Left, rcNormalPosition.Top, rcNormalPosition.Right,
      rcNormalPosition.Bottom]));

    {$IFDEF VERSION4}
    if fsDefaultMonitor in Options then
      FStorage.WriteString(Section, cMonitor, IntToStr(Ord(DefaultMonitor)));
    {$ENDIF}

  end;
end;

procedure TOvcFormState.RestoreStatePrim;
var
  ActiveCtrl : TComponent;
  S          : string;
begin
  if not Assigned(FStorage) then
    Exit;

  FStorage.Open;
  try
    ReadFormState(Form, FSection, fsState in Options, fsPosition in Options);
    if fsActiveControl in Options then begin
      S := FStorage.ReadString(FSection, cActiveCtrl, '');
      ActiveCtrl := Form.FindComponent(S);
      if (ActiveCtrl <> nil) and (ActiveCtrl is TWinControl) and
        TWinControl(ActiveCtrl).CanFocus then
          Form.ActiveControl := TWinControl(ActiveCtrl);
    end;
    UpdateFormState;
  finally
    FStorage.Close;
  end;
end;

procedure TOvcFormState.SaveStatePrim;
begin
  if not Assigned(FStorage) then
    Exit;

  FStorage.Open;
  try
    WriteFormState(Form, FSection);
    if (fsActiveControl in Options) and (Form.ActiveControl <> nil) then
      FStorage.WriteString(FSection, cActiveCtrl, Form.ActiveControl.Name);
  finally
    FStorage.Close;
  end;
end;

procedure TOvcFormState.UpdateFormState;
const
  {$IFDEF WIN32}
  Metrics: array[bsSingle..bsSizeToolWin] of Word =
    (SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME, SM_CXBORDER, SM_CXFRAME);
  {$ELSE}
  Metrics: array[bsSingle..bsDialog] of Word =
    (SM_CXBORDER, SM_CXFRAME, SM_CXDLGFRAME);
  {$ENDIF}
var
  Placement : TWindowPlacement;
begin
  if (Owner <> nil) and Form.HandleAllocated and not (csLoading in ComponentState) then begin
    Placement.Length := SizeOf(TWindowPlacement);
    GetWindowPlacement(Form.Handle, @Placement);
    if not IsWindowVisible(Form.Handle) then
      Placement.ShowCmd := SW_HIDE;
    if TForm(Form).BorderStyle <> bsNone then begin
      Placement.ptMaxPosition.X := -GetSystemMetrics(Metrics[TForm(Form).BorderStyle]);
      Placement.ptMaxPosition.Y := -GetSystemMetrics(Metrics[TForm(Form).BorderStyle] + 1);
    end else
      Placement.ptMaxPosition := Point(0, 0);
    SetWindowPlacement(Form.Handle, @Placement);
  end;
end;


{*** TOvcComponentState ***}

constructor TOvcComponentState.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FStoredProperties := TStringList.Create;
end;

destructor TOvcComponentState.Destroy;
begin
  FStoredProperties.Free;
  FStoredProperties := nil;

  inherited Destroy;
end;

procedure TOvcComponentState.Loaded;
begin
  inherited Loaded;

  UpdateStoredList(Form, FStoredProperties, True);
end;

procedure TOvcComponentState.Notification(AComponent : TComponent; Operation : TOperation);
var
  I         : Integer;
  Component : TComponent;
begin
  inherited Notification(AComponent, Operation);

  if not (csDestroying in ComponentState) and (Operation = opRemove) and
      (FStoredProperties <> nil) then
    for I := FStoredProperties.Count - 1 downto 0 do begin
      Component := TComponent(FStoredProperties.Objects[I]);
      if Component = AComponent then
        FStoredProperties.Delete(I);
    end;
end;

procedure TOvcComponentState.RestoreStatePrim;
begin
  if not Assigned(FStorage) then
    Exit;

  isRestored := True;
  with TOvcDataFiler.Create do
  try
    Section := Self.FSection;
    Storage := Self.FStorage;
    FStorage.Open;
    try
      try
        LoadObjectsProps(Form, FStoredProperties);
      except
      end;
    finally
      FStorage.Close;
    end;
  finally
    Free;
  end;
end;

procedure TOvcComponentState.SaveStatePrim;
begin
  if not Assigned(FStorage) then
    Exit;

  with TOvcDataFiler.Create do
  try
    Section := Self.FSection;
    Storage := Self.FStorage;
    FStorage.Open;
    try
      StoreObjectsProps(Form, FStoredProperties);
    finally
      FStorage.Close;
    end;
  finally
    Free;
  end;
end;

procedure TOvcComponentState.SetNotification;
var
  I         : Integer;
  Component : TComponent;
begin
  for I := FStoredProperties.Count - 1 downto 0 do begin
    if FStoredProperties.Objects[I] is TComponent then begin
      Component := TComponent(FStoredProperties.Objects[I]);
      if Component <> nil then
        {$IFDEF WIN32}
        Component.FreeNotification(Self)
        {$ENDIF WIN32};
    end;
  end;
end;

procedure TOvcComponentState.SetStoredProperties(Value : TStrings);
begin
  FStoredProperties.Assign(Value);
  SetNotification;
end;

procedure TOvcComponentState.WriteState(Writer : TWriter);
begin
  UpdateStoredList(Form, FStoredProperties, False);

  inherited WriteState(Writer);
end;


{*** TOvcPersistentState ***}

procedure TOvcPersistentState.Notification(AComponent : TComponent; Operation : TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation = opRemove then
    if AComponent = FStorage then
      FStorage := nil;
end;

procedure TOvcPersistentState.RestoreState(AnObject : TPersistent;
          const ASection : string);
begin
  if not Assigned(FStorage) then
    Exit;

  with TOvcDataFiler.Create do
  try
    Section := ASection;
    Storage := Self.FStorage;
    try
      FStorage.Open;
      try
        LoadAllProperties(AnObject);
      finally
        FStorage.Close;
      end;
    except
    end;
  finally
    Free;
  end;
end;

procedure TOvcPersistentState.SaveState(AnObject : TPersistent;
          const ASection : string);
begin
  if not Assigned(FStorage) then
    Exit;

  with TOvcDataFiler.Create do
  try
    Section := ASection;
    Storage := Self.FStorage;
    FStorage.Open;
    try
      StoreAllProperties(AnObject);
    finally
      FStorage.Close;
    end;
  finally
    Free;
  end;
end;

procedure TOvcPersistentState.SetStorage(Value : TOvcAbstractStore);
begin
  FStorage := Value;
  {$IFDEF Win32}
  if Value <> nil then
    Value.FreeNotification(Self);
  {$ENDIF}
end;



end.